------------------------------------------------------------------------------
--                                                                          --
--                         SETUP_UTILITY COMPONENTS                         --
--                                                                          --
--                         S E T U P _ U T I L I T Y                        --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                      Copyright (C) 2009-2010, AdaCore                    --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Containers.Vectors;
with Ada.Strings.Fixed;
with GNAT.Regexp; use GNAT.Regexp;
with GNAT.Registry; use GNAT.Registry;
with Text_IO; use Text_IO;
with GNAT.Command_Line; use GNAT.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;

procedure Setup_Utility is
   type Product_Info is record
      Version       : String_Access;
      Install_Root  : String_Access;
      Registry_Root : String_Access;
   end record;

   package Product_Vector_Pkg is
     new Ada.Containers.Vectors (Positive, Product_Info);
   use Product_Vector_Pkg;

   Product_Vector : Vector;
   File : File_Type;
   Last : Natural;

   function Int_Image (I : Integer) return String;
   --  Returns Integer'Image without a leading space

   procedure Patch_File (Param : String);
   --  Patches a file in place; Param is expected to be of the format
   --  "<full file name>#<tag>#<value>" and will cause every match of <tag>
   --  in a file to be replaced by <value>

   procedure Process_Print (Position : Cursor);
   --  Callback for the vector iterator

   procedure Read_System_Settings;
   --  Discovers different settings of the target system

   procedure Scan_GPS;
   --  Scans for the GPS installation

   procedure Scan_Eclipse;
   --  Scans for the Eclipse installation

   procedure Scan_Products (Registry_Key : String);
   --  Scans AdaCore products installed under the given registry key

   procedure Scan_Products_Group (Products_Group : String);
   --  Scans AdaCore products installed under the group of registry keys
   --  starting with a substring Products_Group

   procedure Scan_Workbench;
   --  Scans for the Wind River Workbench installation

   procedure Sort_Products (Product_Vector : in out Vector);
   --  Sorts products in the version-ascending order

   Program_Files : String_Access;

   --------------------------
   -- Read_System_Settings --
   --------------------------

   procedure Read_System_Settings is
      Key : HKEY;
   begin
      Key := Open_Key
        (HKEY_LOCAL_MACHINE,
         "SOFTWARE\Microsoft\Windows\CurrentVersion");
      Program_Files := new String'(Query_Value (Key, "ProgramFilesDir"));
      Close_Key (Key);
   end Read_System_Settings;

   ---------------
   -- Int_Image --
   ---------------

   function Int_Image (I : Integer) return String is
      Img : constant String := Integer'Image (I);
   begin
      if I < 0 then
         return Img;
      else
         return Img (Img'First + 1 .. Img'Last);
      end if;
   end Int_Image;

   --------------
   -- Scan_GPS --
   --------------

   procedure Scan_GPS is
      Key : HKEY;
   begin
      Key := Open_Key
        (HKEY_LOCAL_MACHINE,
         "Software\Ada Core Technologies\GPS");
      Put_Line (File, "[GPS]");
      declare
         Root : constant String := Query_Value (Key, "ROOT");
      begin
         Put_Line (File, "Root=" & Root);
         declare
            Uninst_Key : constant HKEY := Open_Key
              (HKEY_LOCAL_MACHINE,
               "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
               & Query_Value (Key, "GUID"));
         begin
            Put_Line (File, "Uninstaller="
                      & Query_Value (Uninst_Key, "UninstallString"));
            Close_Key (Uninst_Key);
         end;
      exception
         when others =>
            null;
      end;
      Close_Key (Key);
      New_Line (File);
   exception
      when others =>
         null;
   end Scan_GPS;

   ------------------
   -- Scan_Eclipse --
   ------------------

   procedure Scan_Eclipse is
      Eclipse_On_Path : constant String_Access :=
        Locate_Exec_On_Path ("eclipse.exe");
      Eclipse_At_Program_Files : constant String :=
        Program_Files.all & "\eclipse";
   begin
      Put_Line (File, "[Eclipse]");
      if Eclipse_On_Path /= null then
         Put_Line (File, "BasePath=" & Dir_Name (Eclipse_On_Path.all));

      elsif Is_Regular_File (Eclipse_At_Program_Files & "\eclipse.exe") then
         Put_Line (File, "BasePath=" & Eclipse_At_Program_Files);

      else
         --  Give up, just put the default
         Put_Line (File, "BasePath=C:\ECLIPSE");
      end if;
      New_Line (File);
   exception
      when others =>
         null;
   end Scan_Eclipse;

   -------------------
   -- Scan_Products --
   -------------------

   procedure Scan_Products (Registry_Key : String) is
      New_Version_Regexp : constant Regexp :=
        Compile (Pattern => "[0-9]\.[0-9]\.[0-9]w?.*");
      Old_Version_Regexp : constant Regexp :=
        Compile (Pattern => "[0-9]\.[0-9][0-9](w|(a[0-9]?)).*");

      procedure Action
        (Index    : Positive;
         Key      : HKEY;
         Key_Name : String;
         Quit     : in out Boolean);
      --  Callback for the registry iterator

      procedure Action
        (Index    : Positive;
         Key      : HKEY;
         Key_Name : String;
         Quit     : in out Boolean) is
         pragma Unreferenced (Index, Quit);
      begin
         if Match (S => Key_Name, R => New_Version_Regexp) or else
            Match (S => Key_Name, R => Old_Version_Regexp) then
            declare
               Version : constant String_Access := new String'(Key_Name);
               Install_Root : constant String_Access :=
                 new String'(Query_Value (Key, "ROOT"));
            begin
               Append (Product_Vector,
                       New_Item  => (Version       => Version,
                                     Install_Root  => Install_Root,
                                     Registry_Root => new String'(Key_Name))
                      );
            end;
         end if;
      exception
         when Registry_Error =>
            null;
      end Action;

      procedure Loop_Keys is new For_Every_Key (Action);
      Key : HKEY;
   begin
      Key := Open_Key
        (HKEY_LOCAL_MACHINE,
         "Software\Ada Core Technologies\" & Registry_Key);
      Loop_Keys (Key, True);
      Close_Key (Key);
   exception
      when others =>
         null;
   end Scan_Products;

   -------------------------
   -- Scan_Products_Group --
   -------------------------

   procedure Scan_Products_Group (Products_Group : String) is
      Group_Regexp : constant Regexp := Compile (Pattern => Products_Group);

      procedure Action
        (Index    : Positive;
         Key      : HKEY;
         Key_Name : String;
         Quit     : in out Boolean);
      --  Callback for the registry iterator

      procedure Action
        (Index    : Positive;
         Key      : HKEY;
         Key_Name : String;
         Quit     : in out Boolean) is
         pragma Unreferenced (Index, Key, Quit);
      begin
         if Match (S => Key_Name, R => Group_Regexp) then
            Scan_Products (Key_Name);
         end if;
      exception
         when Registry_Error =>
            null;
      end Action;

      procedure Loop_Keys is new For_Every_Key (Action);
      Key : HKEY;
   begin
      Key := Open_Key
        (HKEY_LOCAL_MACHINE, "Software\Ada Core Technologies");
      Loop_Keys (Key, True);
      Close_Key (Key);
   exception
      when others =>
         null;
   end Scan_Products_Group;

   --------------------
   -- Scan_Workbench --
   --------------------

   procedure Scan_Workbench is

      Wrwb_Reg_Path : String (1 .. 4000);
      Path_Last : Natural := 0;

      procedure Action
        (Index    : Positive;
         Key      : HKEY;
         Key_Name : String;
         Quit     : in out Boolean);
      --  Callback for the registry iterator

      procedure Action
        (Index    : Positive;
         Key      : HKEY;
         Key_Name : String;
         Quit     : in out Boolean) is
         pragma Unreferenced (Index, Key, Quit);
      begin
         if Ada.Strings.Fixed.Index (Key_Name, "Wind River Workbench") > 0
           and then Wrwb_Reg_Path (1 .. Path_Last) < Key_Name
         then
            Path_Last := Key_Name'Length;
            Wrwb_Reg_Path (1 .. Path_Last) := Key_Name;
         end if;
      end Action;

      procedure Loop_Keys is new For_Every_Key (Action);
      Key : HKEY;
   begin
      Put_Line (File, "[Workbench]");
      Key := Open_Key
        (HKEY_LOCAL_MACHINE,
         "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall");
      Loop_Keys (Key, True);
      Close_Key (Key);
      if Path_Last /= 0 then
         Key := Open_Key
           (HKEY_LOCAL_MACHINE,
            "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" &
            Wrwb_Reg_Path (1 .. Path_Last));
         declare
            Uninstaller : constant String :=
              Query_Value (Key, "UninstallString");
            Pos : constant Natural :=
              Ada.Strings.Fixed.Index (Uninstaller, "\uninstaller");
         begin
            Put_Line (File, "UninstallKey=" & Wrwb_Reg_Path  (1 .. Path_Last));
            Put_Line (File, "BasePath=" &
                            Uninstaller (Uninstaller'First .. Pos - 1));
         end;
         Close_Key (Key);
      else
         Put_Line (File, "UninstallKey=");
         Put_Line (File, "BasePath=C:\WINDRIVER");
      end if;
      New_Line (File);
   exception
      when others =>
         Put_Line (File, "UninstallKey=");
         Put_Line (File, "BasePath=C:\WINDRIVER");
         New_Line (File);
   end Scan_Workbench;

   -------------------
   -- Sort_Products --
   -------------------

   procedure Sort_Products (Product_Vector : in out Vector) is
      function Compare (Left, Right : Product_Info) return Boolean;
      --  Comparison routine for the vector sorting

      function Compare (Left, Right : Product_Info) return Boolean is
      begin
         return Left.Version.all < Right.Version.all;
      end Compare;

      package Sorting is new Generic_Sorting (Compare);
   begin
      Sorting.Sort (Product_Vector);
   end Sort_Products;

   -------------------
   -- Process_Print --
   -------------------

   procedure Process_Print (Position : Cursor) is
      Product : constant Product_Info := Element (Position);
   begin
      Put_Line (File, "[Product" & To_Index (Position)'Img & ']');
      Put_Line (File, "Version=" & Product.Version.all);
      Put_Line (File, "BasePath=" & Product.Install_Root.all);
      Put_Line (File, "BinPath=" & Product.Install_Root.all & "\bin");
      New_Line (File);
   end Process_Print;

   ----------------
   -- Patch_File --
   ----------------

   procedure Patch_File (Param : String) is
      C1 : constant Natural :=
        Ada.Strings.Fixed.Index (Param, "#");
      C2 : constant Natural :=
        Ada.Strings.Fixed.Index (Param (C1 + 1 .. Param'Last), "#");
      Filename : constant String := Param (Param'First .. C1 - 1);
      Tag      : constant String := Param (C1 + 1 .. C2 - 1);
      Value    : constant String := Param (C2 + 1 .. Param'Last);
      FD : File_Descriptor;
   begin
      FD := Open_Read (Filename, Fmode => Binary);
      declare
         L : constant Integer := Integer (File_Length (FD));
         File : String (1 .. L);
         N : Integer;
         pragma Unreferenced (N);
         Tag_Pos : Integer := 1;
         Tag_Pos_New : Integer;
      begin
         N := Read (FD, File (1)'Address, L);
         Close (FD);
         FD := Create_File (Filename, Fmode => Binary);
         loop
            Tag_Pos_New := Ada.Strings.Fixed.Index (File (Tag_Pos .. L), Tag);
            if Tag_Pos_New = 0 then
               N := Write (FD, File (Tag_Pos)'Address, L - Tag_Pos + 1);
               exit;
            else
               N := Write (FD, File (Tag_Pos)'Address,
                           Tag_Pos_New - Tag_Pos);
               N := Write (FD, Value (Value'First)'Address, Value'Length);
               Tag_Pos := Tag_Pos_New + Tag'Length;
            end if;
         end loop;
         Close (FD);
      end;
   end Patch_File;

   Last_Product : Product_Info;
   Key : HKEY;

begin

   Read_System_Settings;

   Create (File, Name => "settings.ini");

   Initialize_Option_Scan;

   loop
      case GNAT.Command_Line.Getopt
             ("p: "                & --  Look for GNAT products at a given key
              "P: "                & --  Look for GNAT products at given keys
              "e "                 & --  Look for Eclipse
              "w "                 & --  Look for Wind River Workbench
              "r: "                  --  Patch a file in place
              )
      is

         when ASCII.NUL =>
            exit;

         when 'e' =>
            Scan_Eclipse;

         when 'w' =>
            Scan_Workbench;

         when 'p' =>
            Scan_Products (Parameter);

         when 'P' =>
            Scan_Products_Group (Parameter);

         when 'r' =>
            Patch_File (Parameter);

         when others =>
            null;
      end case;
   end loop;

   Scan_GPS;

   Put_Line (File, "[Settings]");

   begin
      Key := Open_Key
        (HKEY_LOCAL_MACHINE, "Software\Ada Core Technologies");
      Put_Line (File, "DefaultRoot=" & Query_Value (Key, "ROOT") & '\');
      Put_Line (File, "DefaultFolder=" & Query_Value (Key, "FOLDER"));
      Close_Key (Key);
   exception
      when others =>
         Put_Line (File, "DefaultRoot=C:\GNATPRO");
         Put_Line (File, "DefaultFolder=GNAT Pro");
   end;

   Sort_Products (Product_Vector);
   Last := Natural (Length (Product_Vector));
   Put_Line (File, "NumProducts=" & Int_Image (Last));
   if Last > 0 then
      Last_Product := Element (Product_Vector, Last);
      Put_Line (File, "LatestProductRoot=" & Last_Product.Install_Root.all);
   end if;
   New_Line (File);
   Iterate (Product_Vector, Process_Print'Unrestricted_Access);

   Close (File);

end Setup_Utility;
